#Produce the document term matrices for modeling

library("tm")
library("SnowballC")

df_sample<-read.csv("Train.csv",stringsAsFactors=F)
v.text<- tolower(df_sample$Body)
v.text<- gsub("<code>|</code>|<p>|</p>|<strong>|</strong>|<pre>|</pre>"," ",v.text, perl=T, useByte=T)
v.text<- gsub("\\b00\\w*\\b|\\b0x\\w*\\b"," ",v.text, perl=T,useByte=T)
v.text<- gsub("\n"," ",v.text, fixed=T)
v.text<- gsub("c#"," csharp ",v.text, fixed=T)               ##So c# and c++ will be recognized as term
v.text<- gsub("f#"," fsharp ",v.text, fixed=T)
v.text<- gsub("\\bc\\b"," clanguag ",v.text, perl=T, useByte=T)
v.text<- gsub("\\br\\b"," rlanguag ",v.text, perl=T, useByte=T)
v.text<- gsub("c++","cplusplus",v.text, fixed=T)
v.text<- gsub("(?!')[[:punct:]]"," ", v.text,perl=T, useByte=T)

v.title<-tolower(df_sample$Title)
v.title<- gsub("<code>|</code>|<p>|</p>|<strong>|</strong>|<pre>|</pre>"," ",v.title, perl=T)
v.title<- gsub("\\b000\\w*\\b|\\b0x\\w*\\b"," ",v.title, perl=T)
v.title<- gsub("\n"," ",v.title, fixed=T)
v.title<- gsub("c#"," csharp ",v.title, fixed=T)               ##So c# and c++ will be recognized as term
v.title<- gsub("f#"," fsharp ",v.title, fixed=T)
v.title<- gsub("\\bc\\b"," clanguag ",v.title, perl=T, useByte=T)
v.title<- gsub("\\br\\b"," rlanguag ",v.title, perl=T, useByte=T)
v.title<- gsub("c++","cplusplus",v.title, fixed=T)
v.title<- gsub("(?!')[[:punct:]]"," ", v.title,perl=T,useByte=T)

text.corpus<-Corpus(VectorSource(v.text))
title.corpus<-Corpus(VectorSource(v.title))
gc()

df.tags<-df_sample$Tags

##Now clear out all stop words
mystops<-c(
 "a","about","above","after","again","against","all","am","an","and","any","appreciate","aren't","are","as","at",
"be","because","been","before","being","below","between","both","but","by","can't","cannot","couldn't","could",
"didn't","did","do","doesn't","does","doing","don't","down","during","each","few","for","from","further",
"hadn't","had","hasn't","has","haven't","have","having","he'd","he'll","he's","he","help","her","here's","here",
"hers","herself","him","himself","his","how's","how","i'd","i'll","i'm","i've","i","if","in","into","isn't",
"is","it's","it","its","itself","let's","me","more","most","mustn't","my","myself","no","nor","not","of",
"off","on","once","only","or","other","ought","our","ours ","ourselves","out","over","own","same","shan't",
"she'd","she'll","she's","shouldn't","should","she","so","some","such","than","thank","thanks","that's","that","the",
"theirs","their","them","themselves","then","there's","there","these","they'd","they'll","they're","they've","they",
"this","those","through","to","too","under","until","up","very","wasn't","was","we'd","we'll","we're","we've",
"we","were","weren't","what's","what","when's","when","where's","where","which","while","who's","who","whom",
"why's","why","with","won't","wouldn't","would","you'd","you'll","you're","you've","you","your","yours","yourself",
"your","application", "can", "code", "create", "data", "error","find", "following", "get", "just", "know","like", "need", "pre",
"use", "using", "want", "way", "will","now", "one", "problem", "something", "sure", "trying", "work", "right", "run", "running",
 "see", "seems", "set", "show", "similar", "simple", "since", "possible",  "value","method","also","app","time","works" , "please"
)

text.corpus<-tm_map(text.corpus, removeWords, mystops )
text.corpus<-tm_map(text.corpus, removeWords, stopwords("english"))
text.corpus<-tm_map(text.corpus, stripWhitespace)
text.stemmed<-tm_map(text.corpus, stemDocument)

title.corpus<-tm_map(title.corpus, removeWords, mystops )
title.corpus<-tm_map(title.corpus, removeWords, stopwords("english"))
title.corpus<-tm_map(title.corpus, stripWhitespace)
title.stemmed<-tm_map(title.corpus, stemDocument)

v.text<-unlist(text.stemmed)
v.title<-unlist(title.stemmed)

##tag.freq <- table(unlist(strsplit(df_sample$Tags," ")))
##tag.freq <- tag.freq[rev(order(tag.freq))]
##tag.names <- names(tag.freq)

wtd.cor.vec<-function(x1, x2, wt)
{
  wt<-wt/sum(wt)
  cov<-sum(wt*(x1-sum(wt*x1))*(x2 - sum(wt*x2)))/(1-sum(wt^2))
  var1<-sum(wt*(x1-sum(wt*x1))^2)/sum(1-sum(wt^2))
  var2<-sum(wt*(x2-sum(wt*x2))^2)/sum(1-sum(wt^2))
  cov/(sqrt(var1*var2))
}


wtd.cor<-function(X, v, wt)
{
  wt<-wt/sum(wt)
  v <- sqrt(wt)*(v - sum(wt*v))
  center <- colSums(wt*X)
  X <- sqrt(wt) * sweep(X, 2, center)
  cov<-crossprod(X, v)
  var1<-colSums(X*X)
  var2<-sum(v*v)
  as.vector(cov/sqrt(var1*var2))
}


find.tag<-function(tag, strings=df_sample$Tags)
{
  re0 <-  paste("\\Q",tag,"\\E",sep="")
  re1 <-  paste("^",re0," | ",re0," | ",re0,"$","|^",re0,"$",sep="")
  grep(re1, strings, perl=T, useBytes=T)
}


get.sample<-function(tag)
{
    v <- find.tag(tag)
    other <- setdiff(1:nrow(df_sample), v)
    other <- other[order(runif(length(other)))]
    if (length(v) > 5000) k <- length(v) else k <- 5000
    ind<-c(v, other[1:k])
    w<-c(rep(1,length(v)),rep(length(other)/k,k))
    list(tags.found=length(v), ind=ind, w=w)
}


ans <- get.sample("r")
df <- df_sample[ans$ind, ]
wts <- ans$w

dtm.text <- removeSparseTerms(DocumentTermMatrix(text.stemmed[ans$ind]), 0.9999)
dtm.title <- removeSparseTerms(DocumentTermMatrix(title.stemmed[ans$ind]), 0.9999)

dtm.text2<-as.matrix(dtm.text)
rm(dtm.text)
gc()

dtm.title2<-as.matrix(dtm.title)
rm(dtm.title)
gc()


cor.body <- function(tag)
{
  #Compute correlation of tag indicator variable with body document term matrix
  ind.actual <- find.tag(tag, df$Tags)
  if (length(ind.actual) == 0) return(rep(0, nrow(dtm.text2)))
  v <- rep(0, nrow(df))
  v[ind.actual] <- 1
  ans <- wtd.cor(dtm.text2, v, wts)
  names(ans) <- colnames(dtm.text2)
  ans
}


cor.title <- function(tag)
{
  #Compute correlation of tag indicator variable with title document term matrix
  ind.actual <- find.tag(tag, df$Tags)
  if (length(ind.actual) == 0) return (rep(0, nrow(dtm.title2)))
  v <- rep(0, nrow(df))
  v[ind.actual] <- 1
  ans <- wtd.cor(dtm.title2, v, wts)
  names(ans) <- colnames(dtm.title2)
  ans
}


stats<-function(act, pred)
{
  tp<-length(intersect(act, pred))
  a1<-tp/length(act)
  a2<-tp/length(pred)
  if (tp == 0) F <- 0 else  F<-2*a1*a2/(a1+a2)
  c(a1, a2, F)
}


testmodel<-function(tag, term, which)
{
  ind.act <- find.tag(tag)
  if (which=="title")
      {ind.pred <- grep(term, v.title, perl=T, useBytes=T)}
  else
      {ind.pred <- grep(term, v.text, perl=T, useBytes=T)}
  stats(ind.act, ind.pred)
}


find.model<-function(tag)
{
   print(tag)
   ind.act <- find.tag(tag, df$Tags)
   x <- gsub("-", ".", tag, perl=T)
   x <- gsub("\\#", "sharp", x, perl=T)
   x <- gsub("\\+", "plus", x, perl=T)

   #begin processing the body
   u <- cor.body(tag)
   body_predictors <- sort(u, decreasing=T)[1:3]
   body_predictors <- union(names(body_predictors), x )

   a <- vector("list",length(body_predictors))
   a <- lapply(1:length(a), function(i) a[[i]] <- c(0,1))
   comb <- expand.grid(a)
   v.regex <- rep(NA, nrow(comb))

   for(j in 1:nrow(comb))
     v.regex[j] <- paste(body_predictors[unlist(comb[j,]) > 0], collapse="|")
   v.regex <- v.regex[v.regex != ""]
   v.regex<-paste("\\b", v.regex, "\\b",sep="")
   fstat <- rep(NA, length(v.regex))

   for(k in 1:length(v.regex))
   {
     ind.pred<-grep(v.regex[k], v.text[ans$ind], perl=T, useBytes=T)
     tp<-sum(wts[intersect(ind.act, ind.pred)])
     a1<-tp/sum(wts[ind.act])
     a2<-tp/sum(wts[ind.pred])
     if (tp == 0) fstat[k] <- 0 else  fstat[k]<-2*a1*a2/(a1+a2)
   }

   m <- which.max(fstat)
   body.model <- v.regex[m]

   #begin processing the title
   u <- cor.title(tag)
   title_predictors <- sort(u, decreasing=T)[1:3]
   title_predictors <- union(names(title_predictors), x)

   a <- vector("list",length(title_predictors))
   a <- lapply(1:4, function(i) a[[i]] <- c(0,1))
   comb <- expand.grid(a)
   v.regex <- rep(NA, nrow(comb))

   for(j in 1:nrow(comb))
     v.regex[j] <- paste(title_predictors[unlist(comb[j,]) > 0], collapse="|")
   v.regex <- v.regex[v.regex != ""]
   v.regex<-paste("\\b", v.regex, "\\b",sep="")
   fstat <- rep(NA, length(v.regex))

   for(k in 1:length(v.regex))
   {
     ind.pred<-grep(v.regex[k], v.title[ans$ind], perl=T, useBytes=T)
     tp<-sum(wts[intersect(ind.act, ind.pred)])
     a1<-tp/sum(wts[ind.act])
     a2<-tp/sum(wts[ind.pred])
     if (tp == 0) fstat[k] <- 0 else  fstat[k]<-2*a1*a2/(a1+a2)
   }

   m <- which.max(fstat)
   title.model <- v.regex[m]
   list(tag=tag.names, title.model=title.model, body.model=body.model)
 }
